home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / DBEXPERT / EXPERT / MAINFORM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-11  |  11.2 KB  |  414 lines
  1. {$DEFINE EXPERT}
  2. { I changed all NewForm to ResultForm (from the NewF.PAS unit) }
  3. unit Mainform;
  4. interface
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, ExtCtrls, Grids, DB, DBTables, Buttons, Mask,
  8.   DBCtrls;
  9.  
  10. Type
  11.   TForm1 = class(TForm)
  12.     Notebook1: TNotebook;
  13.     Label1: TLabel;
  14.     DatabaseList: TListBox;
  15.     BitBtnNext1: TBitBtn;
  16.     BitBtnNext2: TBitBtn;
  17.     Label2: TLabel;
  18.     TableList: TListBox;
  19.     BitBtnBack2: TBitBtn;
  20.     FieldList: TListBox;
  21.     Label3: TLabel;
  22.     BitBtnNext3: TBitBtn;
  23.     BitBtnBack3: TBitBtn;
  24.     Label4: TLabel;
  25.     BitBtnNext4: TBitBtn;
  26.     BitBtnBack4: TBitBtn;
  27.     FilterGroup: TRadioGroup;
  28.     AllBitBtn: TBitBtn;
  29.     NoneBitBtn: TBitBtn;
  30.     StringGrid1: TStringGrid;
  31.     Table1: TTable;
  32.     procedure Notebook1PageChanged(Sender: TObject);
  33.     procedure FormCreate(Sender: TObject);
  34.     procedure DatabaseListClick(Sender: TObject);
  35.     procedure BitBtnNext1Click(Sender: TObject);
  36.     procedure TableListClick(Sender: TObject);
  37.     procedure BitBtnBack2Click(Sender: TObject);
  38.     procedure BitBtnNext2Click(Sender: TObject);
  39.     procedure BitBtnBack3Click(Sender: TObject);
  40.     procedure AllBitBtnClick(Sender: TObject);
  41.     procedure NoneBitBtnClick(Sender: TObject);
  42.     procedure BitBtnNext3Click(Sender: TObject);
  43.     procedure BitBtnBack4Click(Sender: TObject);
  44.     procedure FieldListClick(Sender: TObject);
  45.     procedure BitBtnNext4Click(Sender: TObject);
  46.   private
  47.     { Private declarations }
  48.   public
  49.     { Public declarations }
  50. {$IFDEF EXPERT}
  51.     UnitName: String;
  52. {$ENDIF}
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59. {$R *.DFM}
  60.  
  61. uses
  62.   Newf;
  63.  
  64. const FieldTypeCount = 14;
  65.  
  66. type
  67.   CVTable = array [1..FieldTypeCount, 1..2] of TClass;
  68.  
  69. const ConvertTable: CVTable = (
  70.   (TStringField, TDBEdit),
  71.   (TIntegerField, TDBEdit),
  72.   (TSmallintField, TDBEdit),
  73.   (TWordField, TDBEdit),
  74.   (TFloatField, TDBEdit),
  75.   (TCurrencyField, TDBEdit),
  76.   (TBCDField, TDBEdit),
  77.   (TBooleanField, TDBCheckBox),
  78.   (TDateTimeField, TDBEdit),
  79.   (TDateField, TDBEdit),
  80.   (TTimeField, TDBEdit),
  81.   (TMemoField, TDBMemo),
  82.   (TBlobField, TDBImage),      {just a guess}
  83.   (TGraphicField, TDBImage));
  84.  
  85. function ConvertClass(FieldClass: TFieldClass) : TControlClass;
  86. var
  87.   I: Integer;
  88.   Found: Boolean;
  89. begin
  90.   Found := False;
  91.   for I := 1 to FieldTypeCount do
  92.     if ConvertTable [I, 1] = FieldClass then
  93.     begin
  94.       ConvertClass := TControlClass (ConvertTable [I, 2]);
  95.       Found := True;
  96.       break; {jump out of for loop}
  97.     end;
  98.   if not Found then
  99.     raise Exception.Create ('Match not found');
  100. end;
  101.  
  102. procedure NormalizeString (var S: string);
  103. var
  104.   N: Integer;
  105. begin
  106.   {remove the T}
  107.   Delete (S, 1, 1);
  108.   {chek if the string is a valid
  109.   Pascal identifier: if not repalce spaces
  110.   and other characters with underscores}
  111.   if not IsValidIdent (S) then
  112.     for N := 1 to Length (S) do
  113.       if not ((S[N] in ['A'..'Z']) or (S[N] in ['a'..'z'])
  114.           or (S[N] in ['0'..'9'])) then
  115.         S [N] := '_';
  116. end;
  117.  
  118. procedure TForm1.Notebook1PageChanged(Sender: TObject);
  119. begin
  120.   {copy the name of the page into the caption}
  121.   Caption := 'Marco & Dr.Bob''s Database Expert - ' +
  122.     NoteBook1.ActivePage;
  123. end;
  124.  
  125. procedure TForm1.FormCreate(Sender: TObject);
  126. begin
  127.   {fill the first listbox}
  128.   Session.GetDatabaseNames (
  129.     DatabaseList.Items);
  130.   Notebook1.PageIndex := 0;
  131. end;
  132.  
  133. procedure TForm1.DatabaseListClick(Sender: TObject);
  134. begin
  135.   {once a database is selected, the user
  136.   can move to the following page}
  137.   BitBtnNext1.Enabled := True;
  138. end;
  139.  
  140. procedure TForm1.BitBtnNext1Click(Sender: TObject);
  141. var
  142.   CurrentDB, CurrentFilter: string;
  143. begin
  144.   CurrentDB := DatabaseList.Items [
  145.     DatabaseList.ItemINdex];
  146.   CurrentFilter := FilterGroup.Items [
  147.     FilterGroup.ItemIndex];
  148.   {get the tables of the current DB}
  149.   Session.GetTableNames (
  150.     CurrentDB, CurrentFilter,
  151.     True, False, TableList.Items);
  152.   {move to the next page}
  153.   NoteBook1.PageIndex := 1;
  154.   BitBtnNext2.Enabled := False;
  155. end;
  156.  
  157. procedure TForm1.TableListClick(Sender: TObject);
  158. begin
  159.   BitBtnNext2.Enabled := True;
  160. end;
  161.  
  162. procedure TForm1.BitBtnBack2Click(Sender: TObject);
  163. begin
  164.   NoteBook1.PageIndex := 0;
  165. end;
  166.  
  167. procedure TForm1.BitBtnNext2Click(Sender: TObject);
  168. var
  169.   I: Integer;
  170. begin
  171.   {set the properties of a table}
  172.   with Table1 do
  173.   begin
  174.     DatabaseName := DatabaseList.Items[
  175.       DatabaseList.ItemIndex];
  176.     TableName := TableList.Items[
  177.       TableList.ItemIndex];
  178.     {load the fields definition}
  179.     FieldDefs.Update;
  180.   end;
  181.   {clear the list then fill it}
  182.   FieldList.Clear;
  183.   for I := 0 to Table1.FieldDefs.Count - 1 do
  184.     {add number, name, and class name}
  185.     FieldList.Items.Add (Format (
  186.       '%d) %s [%s]',
  187.       [Table1.FieldDefs[I].FieldNo,
  188.       Table1.FieldDefs[I].Name,
  189.       Table1.FieldDefs[I].FieldClass.ClassName]));
  190.   NoteBook1.PageIndex := 2;
  191.   BitBtnNext3.Enabled := False;
  192. end;
  193.  
  194. procedure TForm1.BitBtnBack3Click(Sender: TObject);
  195. begin
  196.   NoteBook1.PageIndex := 1;
  197. end;
  198.  
  199. procedure TForm1.AllBitBtnClick(Sender: TObject);
  200. var
  201.   I: Integer;
  202. begin
  203.   {select each item}
  204.   for I := 0 to FieldList.Items.Count - 1 do
  205.     FieldList.Selected [I] := True;
  206.   BitBtnNext3.Enabled := True;
  207. end;
  208.  
  209. procedure TForm1.NoneBitBtnClick(Sender: TObject);
  210. var
  211.   I: Integer;
  212. begin
  213.   {unselect each item}
  214.   for I := 0 to FieldList.Items.Count - 1 do
  215.     FieldList.Selected [I] := False;
  216.   BitBtnNext3.Enabled := False;
  217. end;
  218.  
  219. procedure TForm1.BitBtnNext3Click(Sender: TObject);
  220. var
  221.   I, RowNum: Integer;
  222. begin
  223.   {reserve enough rows}
  224.   StringGrid1.RowCount := FieldList.Items.Count;
  225.   {empty the string grid}
  226.   for I := 0 to StringGrid1.RowCount - 1 do
  227.   begin
  228.     StringGrid1.Cells [0, I] := '';
  229.     StringGrid1.Cells [1, I] := '';
  230.   end;
  231.   {scan the list of fields, showing the
  232.   corresponding data aware components,
  233.   only if the field is selected}
  234.   RowNum := 0;
  235.   for I := 0 to FieldList.Items.Count - 1 do
  236.     if FieldList.Selected [I] then
  237.     begin
  238.       StringGrid1.Cells [0, RowNum] := Format ('%d) %s [%s]',
  239.         {add number, name, and control class}
  240.         [Table1.FieldDefs[I].FieldNo,
  241.         Table1.FieldDefs[I].Name,
  242.         ConvertClass(Table1.FieldDefs[I].FieldClass).ClassName]);
  243.       StringGrid1.Cells [1, RowNum] := Table1.FieldDefs[I].Name;
  244.       Inc (RowNum);
  245.     end;
  246.   {set the real number of rows}
  247.   StringGrid1.RowCount := RowNum;
  248.   NoteBook1.PageIndex := 3;
  249. end;
  250.  
  251. procedure TForm1.BitBtnBack4Click(Sender: TObject);
  252. begin
  253.   NoteBook1.PageIndex := 2;
  254. end;
  255.  
  256. procedure TForm1.FieldListClick(Sender: TObject);
  257. begin
  258.   BitBtnNext3.Enabled := True;
  259. end;
  260.  
  261. {Generate button}
  262. procedure TForm1.BitBtnNext4Click(Sender: TObject);
  263. var
  264.   I, RowNum, Y, H, Hmax: Integer;
  265.   NewName: string;
  266.   NewLabel: TLabel;
  267.   NewDBComp: TControl;
  268.   CtrlClass: TControlClass;
  269. {$IFDEF EXPERT}
  270.   F: System.text;
  271. {$ENDIF}
  272. begin
  273.   {Generate the form and connect the table}
  274.   ResultForm := TResultForm.Create (Application);
  275.   with ResultForm.Table1 do
  276.   begin
  277.     DatabaseName := Table1.DatabaseName;
  278.     TableName := Table1.TableName;
  279.     Active := True;
  280.   end;
  281. {$IFDEF EXPERT}
  282.   {generate the first part of the unit source}
  283.   System.Assign(f,UnitName+'.PAS');
  284.   System.Rewrite(f);
  285.   writeln(f,'unit ',ExtractFileName(UnitName),';');
  286.   writeln(f,'interface');
  287.   writeln(f,'uses');
  288.   writeln(f,'  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,');
  289.   writeln(f,'  Forms, Dialogs, DB, DBTables, DBCtrls, ExtCtrls;');
  290.   writeln(f);
  291.   writeln(f,'type');
  292.   writeln(f,'  TResultForm = class(TForm)');
  293.   writeln(f,'    Panel1: TPanel;');
  294.   writeln(f,'    DBNavigator1: TDBNavigator;');
  295.   writeln(f,'    ScrollBox1: TScrollBox;');
  296.   writeln(f,'    DataSource1: TDataSource;');
  297.   writeln(f,'    Table1: TTable;');
  298. {$ENDIF}
  299.   {generates field editors}
  300.   Y := 10;
  301.   RowNum := 0;
  302.   for I := 0 to FieldList.Items.Count - 1 do
  303.     if FieldList.Selected [I] then
  304.     begin
  305.       {create a label with the field name}
  306.       NewLabel := TLabel.Create (ResultForm);
  307.       NewLabel.Parent := ResultForm.ScrollBox1;
  308.       NewLabel.Name := 'Label' + IntToStr (I);
  309. {$IFDEF EXPERT}
  310.       writeln(f,'    Label',IntToStr(i),': TLabel;');
  311. {$ENDIF}
  312.       NewLabel.Caption :=
  313.         StringGrid1.Cells [1, RowNum];
  314.       NewLabel.Top := Y;
  315.       NewLabel.Left := 10;
  316.       NewLabel.Width := 130;
  317.  
  318.       {create a control of the proper type,
  319.       using a class reference}
  320.       CtrlClass := ConvertClass (
  321.         Table1.FieldDefs[I].FieldClass);
  322.       NewDBComp := CtrlClass.Create (ResultForm);
  323.       NewDBComp.Parent := ResultForm.ScrollBox1;
  324.       NewName := CtrlClass.ClassName +
  325.         Table1.FieldDefs[I].Name;
  326.       NormalizeString (NewName);
  327.       NewDBComp.Name := NewName;
  328. {$IFDEF EXPERT}
  329.       writeln(f,'    ',NewName,': ',CtrlClass.ClassName,';');
  330. {$ENDIF}
  331.       NewDBComp.Top := Y;
  332.       NewDBComp.Left := 150;
  333.       NewDbComp.Width := ResultForm.ScrollBox1.Width - 160;
  334.  
  335.       {connect the control with the proper
  336.       data source and field}
  337.       if CtrlClass = TDBEdit then
  338.       begin
  339.         TDBEdit (NewDBComp).DataSource :=
  340.           ResultForm.DataSource1;
  341.         TDBEdit (NewDBComp).DataField :=
  342.           Table1.FieldDefs[I].Name;
  343.       end
  344.       else if CtrlClass = TDBMemo then
  345.       begin
  346.         TDBMemo (NewDBComp).DataSource :=
  347.           ResultForm.DataSource1;
  348.         TDBMemo (NewDBComp).DataField :=
  349.           Table1.FieldDefs[I].Name;
  350.       end
  351.       else if CtrlClass = TDBImage then
  352.       begin
  353.         TDBImage (NewDBComp).DataSource :=
  354.           ResultForm.DataSource1;
  355.         TDBImage (NewDBComp).DataField :=
  356.           Table1.FieldDefs[I].Name;
  357.         TDBImage (NewDBComp).Height :=
  358.           TDBImage (NewDBComp).Height * 2;
  359.       end
  360.       else if CtrlClass = TDBCheckBox then
  361.       begin
  362.         TDBCheckBox (NewDBComp).DataSource :=
  363.           ResultForm.DataSource1;
  364.         TDBCheckBox (NewDBComp).DataField :=
  365.           Table1.FieldDefs[I].Name;
  366.       end;
  367.  
  368.       {compute the position of the next component}
  369.       Y := Y + NewDBComp.Height + 10;
  370.       {increase the string grid row}
  371.       Inc (RowNum);
  372.     end; {end if and for}
  373.  
  374.   {size and show the form}
  375.   H := Y + ResultForm.Panel1.Height;
  376.   HMax := (Screen.Height - 40 -
  377.     (ResultForm.Height - ResultForm.ClientHeight));
  378.   if H > HMax then
  379.   begin
  380.     H := HMax;
  381.     ResultForm.Width := ResultForm.Width +
  382.       GetSystemMetrics (SM_CXVSCROLL);
  383.   end;
  384.   ResultForm.ClientHeight := H;
  385. {$IFDEF EXPERT}
  386.   writeln(f,'    procedure FormClose(Sender: TObject; var Action: TCloseAction);');
  387.   writeln(f,'  private');
  388.   writeln(f,'    { Private declarations }');
  389.   writeln(f,'  public');
  390.   writeln(f,'    { Public declarations }');
  391.   writeln(f,'  end;');
  392.   writeln(f);
  393.   writeln(f,'var');
  394.   writeln(f,'  ResultForm: TResultForm;');
  395.   writeln(f);
  396.   writeln(f,'implementation');
  397.   writeln(f);
  398.   writeln(f,'{$R *.DFM}');
  399.   writeln(f);
  400.   writeln(f,'procedure TResultForm.FormClose(Sender: TObject; var Action: TCloseAction);');
  401.   writeln(f,'begin');
  402.   writeln(f,'  Action := caFree;');
  403.   writeln(f,'end;');
  404.   writeln(f);
  405.   writeln(f,'end.');
  406.   System.Close(f);
  407.   ModalResult := mrOk
  408. {$ELSE}
  409.   ResultForm.Show;
  410. {$ENDIF}
  411. end;
  412.  
  413. end.
  414.